home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / Debconf / FrontEnd / Web.pm < prev   
Encoding:
Perl POD Document  |  2009-03-24  |  2.5 KB  |  138 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::FrontEnd::Web;
  6. use IO::Socket;
  7. use IO::Select;
  8. use CGI;
  9. use strict;
  10. use Debconf::Gettext;
  11. use base qw(Debconf::FrontEnd);
  12.  
  13.  
  14.  
  15. sub init {
  16.     my $this=shift;
  17.  
  18.     $this->SUPER::init(@_);
  19.     
  20.     $this->port(8001) unless defined $this->port;
  21.     $this->formid(0);
  22.     $this->interactive(1);
  23.     $this->capb('backup');
  24.     $this->need_tty(0);
  25.  
  26.     $this->server(IO::Socket::INET->new(
  27.         LocalPort => $this->port,
  28.         Proto => 'tcp',
  29.         Listen => 1,
  30.         Reuse => 1,
  31.         LocalAddr => '127.0.0.1',
  32.     )) || die "Can't bind to ".$this->port.": $!";
  33.  
  34.     print STDERR sprintf(gettext("Note: Debconf is running in web mode. Go to http://localhost:%i/"),$this->port)."\n";
  35. }
  36.  
  37.  
  38. sub client {
  39.     my $this=shift;
  40.     
  41.     $this->{client}=shift if @_;
  42.     return $this->{client} if $this->{client};
  43.  
  44.     my $select=IO::Select->new($this->server);
  45.     1 while ! $select->can_read(1);
  46.     my $client=$this->server->accept;
  47.     my $commands='';
  48.     while (<$client>) {
  49.         last if $_ eq "\r\n";
  50.         $commands.=$_;
  51.     }
  52.     $this->commands($commands);
  53.     $this->{client}=$client;
  54. }
  55.  
  56.  
  57. sub closeclient {
  58.     my $this=shift;
  59.     
  60.     close $this->client;
  61.     $this->client('');
  62. }
  63.  
  64.  
  65. sub showclient {
  66.     my $this=shift;
  67.     my $page=shift;
  68.  
  69.     my $client=$this->client;
  70.     print $client $page;
  71. }
  72.  
  73.  
  74. sub go {
  75.     my $this=shift;
  76.  
  77.     $this->backup('');
  78.  
  79.     my $httpheader="HTTP/1.0 200 Ok\nContent-type: text/html\n\n";
  80.     my $form='';
  81.     my $id=0;
  82.     my %idtoelt;
  83.     foreach my $elt (@{$this->elements}) {
  84.         $idtoelt{$id}=$elt;
  85.         $elt->id($id++);
  86.         my $html=$elt->show;
  87.         if ($html ne '') {
  88.             $form.=$html."<hr>\n";
  89.         }
  90.     }
  91.     return 1 if $form eq '';
  92.  
  93.     my $formid=$this->formid(1 + $this->formid);
  94.  
  95.     $form="<html>\n<title>".$this->title."</title>\n<body>\n".
  96.            "<form><input type=hidden name=formid value=$formid>\n".
  97.            $form."<p>\n";
  98.  
  99.     if ($this->capb_backup) {
  100.         $form.="<input type=submit value=".gettext("Back")." name=back>\n";
  101.     }
  102.     $form.="<input type=submit value=".gettext("Next").">\n";
  103.     $form.="</form>\n</body>\n</html>\n";
  104.  
  105.     my $query;
  106.     do {
  107.         $this->showclient($httpheader . $form);
  108.     
  109.         $this->closeclient;
  110.         $this->client;
  111.         
  112.         my @get=grep { /^GET / } split(/\r\n/, $this->commands);
  113.         my $get=shift @get;
  114.         my ($qs)=$get=~m/^GET\s+.*?\?(.*?)(?:\s+.*)?$/;
  115.     
  116.         $query=CGI->new($qs);
  117.     } until ($query->param('formid') eq $formid);
  118.  
  119.     if ($this->capb_backup && $query->param('back') ne '') {
  120.         return '';
  121.     }
  122.  
  123.     foreach my $id ($query->param) {
  124.         next unless $idtoelt{$id};
  125.         
  126.         $idtoelt{$id}->value($query->param($id));
  127.         delete $idtoelt{$id};
  128.     }
  129.     foreach my $elt (values %idtoelt) {
  130.         $elt->value('');
  131.     }
  132.     
  133.     return 1;
  134. }
  135.  
  136.  
  137. 1
  138.